Cream of the Crop 22/Cream of the Crop 22.iso/program/ctlib100.zip/INSTALL.LZH/BTREES3.PAS

Pascal/Delphi Source File | 1996-10-12 | 5KB | 194 lines

{**************************************************************************}
{*  BitSoft Development, L.L.C.                                           *}
{*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
{*  All rights reserved.                                                  *}
{*  Containers Library demo                                               *}
{**************************************************************************}

program BTrees3;

{$X+}

{ Sample program for creating an object B tree. }

uses Objects, Containr, ctBTrees,
     {$ifdef Windows}
     WinCtr;
     {$else}
     Crt;
     {$endif}

type
  String20 = string[20];
  String18 = string[18];
  String15 = string[15];
  String25 = string[25];

type
  PContact = ^TContact;
  TContact = object (TObject)
      FirstName,
      LastName,
      Phone,
      Company : PString;
    constructor Init(ALastName: String20; AFirstName: String15;
      APhone : String18; ACompany : String25);
    constructor Load(var S: TStream);
    destructor Done; virtual;
    procedure Store(var S: TStream);
  end; { TContact }

constructor TContact.Init(ALastName: String20; AFirstName: String15;
  APhone : String18; ACompany : String25);
begin
  FirstName := NewStr(AFirstName);
  LastName := NewStr(ALastName);
  Phone := NewStr(APhone);
  Company := NewStr(ACompany);
end;

constructor TContact.Load(var S: TStream);
begin
  FirstName := S.ReadStr;
  LastName := S.ReadStr;
  Phone := S.ReadStr;
  Company := S.ReadStr;
end;

destructor TContact.Done;
begin
  DisposeStr(FirstName);
  DisposeStr(LastName);
  DisposeStr(Phone);
  DisposeStr(Company);
end;

procedure TContact.Store(var S: TStream);
begin
  S.WriteStr(FirstName);
  S.WriteStr(LastName);
  S.WriteStr(Phone);
  S.WriteStr(Company);
end;

const
  RContact : TStreamRec = (
    ObjType: 1000;
    VmtLink: Ofs(TypeOf(TContact)^);
    Load:    @TContact.Load;
    Store:   @TContact.Store);

type
  PContactList = ^TContactList;
  TContactList = object(TObjectBTree)
    function KeyOf(Item : Pointer) : Pointer; virtual;
  end; { TContactList }

function TContactList.KeyOf(Item : Pointer) : Pointer;
begin
  KeyOf := PContact(Item)^.LastName;
end;

procedure DisplayContacts(ContactList : PGraph);

  procedure PrintInfo (Item : Pointer); far;
  begin
    with PContact(Item)^ do
      writeln(LastName^, '':15 - Length(LastName^),
        FirstName^, '':15 - Length(FirstName^),
        Phone^, '':20 - Length(Phone^),
        Company^, '':20 - Length(Company^));
  end;

begin
  ContactList^.ForEach(@PrintInfo);
end;

procedure DisplayFirst(ContactList : PGraph);
var
  Item : Pointer;
begin
  Item := ContactList^.First;
  Writeln('First item:');
  with PContact(Item)^ do
    writeln(LastName^, '':15 - Length(LastName^),
      FirstName^, '':15 - Length(FirstName^),
      Phone^, '':20 - Length(Phone^),
      Company^, '':20 - Length(Company^));
  ContactList^.DoneItem(Item); { not required }
end;

procedure DisplayLast(ContactList : PGraph);
var
  Item : Pointer;
begin
  Item := ContactList^.Last;
  Writeln('Last item:');
  with PContact(Item)^ do
    writeln(LastName^, '':15 - Length(LastName^),
      FirstName^, '':15 - Length(FirstName^),
      Phone^, '':20 - Length(Phone^),
      Company^, '':20 - Length(Company^));
  ContactList^.DoneItem(Item); { not required }
end;

procedure FindLastName(ContactList : PGraph; LastName : string);
var
  Item : Pointer;
begin
  Item := ContactList^.KeyFirst(@LastName);
  Writeln('Item found with last name ''', LastName, ''':');
  with PContact(Item)^ do
    writeln(LastName^, '':15 - Length(LastName^),
      FirstName^, '':15 - Length(FirstName^),
      Phone^, '':20 - Length(Phone^),
      Company^, '':20 - Length(Company^));
  ContactList^.DoneItem(Item); { not required }
end;

var
  ContactList : PContactList;
  Contact : TContact;
  Stream : PBufStream;

begin
  ClrScr;

  { Create the stream }
  Stream := New(PBufStream, Init('btrees.dat', stCreate, 1024));

  { Register the TContact object }
  RegisterType(RContact);

  { Create the B tree }
  ContactList := New(PContactList, Init(3, SizeOf(String20) +
    SizeOf(String18) + SizeOf(String15) + SizeOf(String25), Stream, 5));

  { Insert the items in the B tree }
  with ContactList^ do
  begin
    Insert(New(PContact, Init('Lewis', 'Carl', '(506) 83-780',
      'Running, Corp.')));
    Insert(New(PContact, Init('Benton', 'Michael', '(403) 33-973',
      'ER, Inc.')));
    Insert(New(PContact, Init('Wagner', 'Robert', '(906) 11-230',
      'Symphony, Ltd.')));
    Insert(New(PContact, Init('Smith', 'John', '(656) 75-843',
      'InterComm, Corp.')));
  end; { with }

  DisplayContacts(ContactList);
  Writeln;
  DisplayFirst(ContactList);
  Writeln;
  DisplayLast(ContactList);
  Writeln;
  FindLastName(ContactList, 'Wagner');

  { Dispose of the B tree }
  Dispose(ContactList, Done);

  { Dispose of the stream }
  Dispose(Stream, Done);
end.